00100		SUBROUTINE CLIPS
00200
00300	C	OCTOBER  22,  68
00400
00500		COMMON /EDGEC/ A0,A1,A2,A3,A4,A5,A6,A7,
00600		1 DEBUG,T,XP,YP,PARMAX,
00700		1 HALF,DIF,RR,COH,RX,RY,CL,SL,D,B,FOUND
00800
00900		COMMON /LISTC/ LIST,LIST5,NEWEND,LO
01000
01100		COMMON/COMMAC/BCLIP,TCLIP,BITS,IWID,LINLEN,FLINE,LLINE,
01200		1 LSIDE,RSIDE,DTA,HYSTAB
01300
01400		DIMENSION LIST5(0/1000),LIST(6,1000),
01500		1 XP(0/176),YP(0/176),T(0/1415),HYSTAB(0/15)
01600
01700		INTEGER BCLIP,TCLIP,FLINE,LLINE,LSIDE,RSIDE,
01800		1 HYSTAB,IB,HEL,I,HYSSUM
01900
02000		REAL INT,HIG,QAL,QALOLD,NUPO,CENTER,DEVIAT
02100
02200		LOGICAL FIRST,BOO1,BOO2
02300
02400		NUPO=((LLINE-FLINE+1)/2)*(RSIDE-LSIDE+1)
02500		HYSSUM=0
02600		CENTER=0.0
02700		DO 2 IB=0,15
02800		CENTER=CENTER+HYSTAB(IB)*IB
02900	2	HYSSUM=HYSSUM+HYSTAB(IB)
03000		CENTER=CENTER/NUPO
03100		IF(HYSSUM.NE.NUPO) PAUSE 'ERROR IN HISTO'
03200		DEVIAT=0.0
03300		DO 4 IB=0,15
03400	4	DEVIAT=DEVIAT+HYSTAB(IB)*((IB-CENTER)**2)
03500		DEVIAT=SQRT(DEVIAT/NUPO)
03600	6	FORMAT(' DEVIAT=',F5.1/' CENTER=',F5.1/)
03700		TYPE 6,DEVIAT,CENTER
03800
03900		FIRST=.TRUE.
04000		GOTO 23
04100	13	FIRST=.FALSE.
04200	23	QALOLD=-1.E15
04300		INT=(FLOAT(HYSTAB(0))+0.1)/NUPO
04400		DO 43 IB=0,14,2
04500		HIG=FLOAT(HYSTAB(IB)+HYSTAB(IB+1))/NUPO
04600		QAL=FLOAT(IB)/8.0-1.0/(INT*128.0)-32.*(INT**2)-4.0*HIG
04700		IF(QALOLD.GT.QAL) GOTO 43
04800		QALOLD=QAL
04900		IF(.NOT.FIRST) GOTO 33
05000		BCLIP=7-IB/2
05100		GOTO 43
05200	33	TCLIP=IB/2
05300	43	INT=INT+FLOAT(HYSTAB(IB+1)+HYSTAB(IB+2))/NUPO
05400
05500		DO 53 I=0,7
05600		HEL=HYSTAB(I)
05700		HYSTAB(I)=HYSTAB(15-I)
05800	53	HYSTAB(15-I)=HEL
05900		IF(FIRST) GOTO 13
06000		IF(BCLIP.EQ.0) BCLIP=TCLIP
06100		IF(TCLIP.EQ.7) TCLIP=BCLIP
06200		RETURN
06300		END
	SUBROUTINE PLUG(OLDEND,RX,RY,V1,V2,D,B)
	DIMENSION LIST(6,1000),LIST5(0/1000)
	INTEGER OLDEND,NE,NL,LIST5,NEWEND
	REAL RX,RY,V1,V2,LIST,D,B
	LOGICAL LO
	COMMON /LISTC/ LIST,LIST5,NEWEND,LO
	NE=LIST5(NEWEND)
	IF(NE.LE.1000) GOTO 10
	IF(LO) RETURN
	LO=.TRUE.
	TYPE 5,NE
5	FORMAT(17H PLUGGING STOPPEDI)
	RETURN
10	LIST5(NEWEND)=LIST5(NE)
	LIST5(NE)=LIST5(OLDEND)
	LIST5(OLDEND)=NE
	LIST(1,NE)=RX
	LIST(2,NE)=RY
	LIST(3,NE)=V1
	LIST(4,NE)=V2
	LIST(5,NE)=D
	LIST(6,NE)=B
	IF(OLDEND.EQ.NEWEND) NEWEND=NE
	RETURN
	END
00100		SUBROUTINE STRAIT
00200
00300	C	OCTOBER  14,  69
00400
00500		DIMENSION LIST(6,1000),LIST5(0/1000),HYSTAB(0/15),
00600		1 T(0/1415),XP(0/176),YP(0/176)
00700		INTEGER N,NEWEND,M,LIST5,K,I,J,LLINE,RSIDE,FLINE,LSIDE
00800		REAL RX,RY,V1,V2,LIST,D,B,RTO,RR,C,CLP,CL,Q
00900		LOGICAL LO
01000
01100		COMMON /EDGEC/ A0,A1,A2,A3,A4,A5,A6,A7,
01200		1 DEBUG,T,XP,YP,PARMAX,
01300		1 HALF,FILE,RR,COH,RX,RY,CL,SL,D,B,FOUND
01400		COMMON /LISTC/ LIST,LIST5,NEWEND,LO
01500		COMMON/COMMAC/BCLIP,TCLIP,BITS,IWID,LINLEN,FLINE,LLINE,
01600		1 LSIDE,RSIDE,DTA,HYSTAB
01700
01800		RTO=0.937
01900		LSIDE=IFIX(LSIDE*RTO+0.5)
02000		RSIDE=IFIX(RSIDE*RTO+0.5)
02100		C=LLINE+FLINE
02200
02300	C	EXCHANGING CONTENTS OF N AND M
02400		DO 20 N=1,1000
02500		I=N-1
02600		M=LIST5(I)
02700		IF(N.EQ.M) GOTO 15
02800
02900	C	FIND THE I SUCH THAT LIST5(I).EQ.N
03000	5	J=LIST5(I)
03100		IF(J.EQ.N) GOTO 7
03200		I=J
03300		IF(I.NE.NEWEND) GOTO 5
03400
03500		PAUSE 'NEWEND EXCEEDED'
03600	7	LIST5(I)=M
03700		LIST5(N-1)=N
03800		K=LIST5(N)
03900		LIST5(N)=LIST5(M)
04000		LIST5(M)=K
04100
04200		RX=LIST(1,N)
04300		RY=LIST(2,N)
04400		V1=LIST(3,N)
04500		V2=LIST(4,N)
04600		D=LIST(5,N)
04700		B=LIST(6,N)
04800		DO 10 I=1,6
04900	10	LIST(I,N)=LIST(I,M)
05000		LIST(1,M)=RX
05100		LIST(2,M)=RY
05200		LIST(3,M)=V1
05300		LIST(4,M)=V2
05400		LIST(5,M)=D
05500		LIST(6,M)=B
05600
05700		IF(M.EQ.NEWEND) PAUSE 'ERROR IN STRAIT'
05800		IF(N.EQ.NEWEND) NEWEND=M
05900		GOTO 20
06000	15	IF(N.NE.NEWEND) GOTO 20
06100
06200		DO 17 N=1,NEWEND
06300		LIST(1,N)=LIST(1,N)*RTO
06400		LIST(2,N)=-LIST(2,N)+C
06500		CL=-LIST(3,N)
06600		CLP=LIST(4,N)*RTO
06700		Q=SQRT(CLP**2+CL**2)
06800		LIST(3,N)=CL/Q
06900		LIST(4,N)=CLP/Q
07000	17	CONTINUE
07100
07200		RR=RR*(RTO+1.0)/2.0
07300
07400		RETURN
07500	20	CONTINUE
07600		PAUSE 'END NOT FOUND'
07700		CALL EXIT
07800		END